home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tspa3140.zip / TSUNTC.TST < prev    next >
Text File  |  1992-08-26  |  2KB  |  77 lines
  1. (* This is a test program for the TSUNTC.TPU unit
  2.    Updated 19-Aug-89, 12-Nov-89, 14-Jul-90, 26-Aug-92
  3. *)
  4.  
  5. uses Dos,
  6.      Crt,
  7.      TSUNTC;
  8.  
  9. procedure LOGO;
  10. begin
  11.   writeln;
  12.   writeln ('TSUNTC unit test by Prof. Timo Salmi, 26-Aug-92');
  13.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  14.   writeln;
  15. end;  (* logo *)
  16.  
  17. (* Don't play it again, Sam *)
  18. procedure TEST1;
  19. const tune : array [1..7] of string[2]
  20.            = ('c ', 'd ', 'e ', 'f ', 'g ', 'a ', 'b ');
  21. var i : byte;
  22. begin
  23.   Delay (100);
  24.   for i := 1 to 7 do PLAYNOTE (tune[i], 4, 400);
  25.   PLAYNOTE ('c', 5, 400);
  26. end;  (* test1 *)
  27.  
  28. (* Display something in reverse *)
  29. procedure TEST2;
  30. begin
  31.   TextColor (Black);
  32.   TextBackground (Brown);
  33.   ClrScr;
  34.   LOGO;
  35.   REVCOLOR;
  36.   writeln ('Display something in reverse');
  37.   REVCOLOR;
  38.   writeln ('All back to norbal :-)');
  39.   writeln ('Rats!')
  40. end;  (* test2 *)
  41.  
  42. (* Demo of high-intesity BackGround *)
  43. procedure TEST3;
  44. begin
  45.   HIBACK;
  46.   TextColor (blink);
  47.   TextBackground (Blue);
  48.   ClrScr;
  49.   TextColor (Black+blink);
  50.   TextBackground (Brown);
  51.   write   ('When BLINKOFF has been set, blink in ');
  52.   TextColor (LightRed+blink);
  53.   write   ('TextColor');
  54.   TextColor (Black+blink);
  55.   writeln (' produces');
  56.   writeln ('a high-intensity background instead of a blinking text.');
  57.   writeln ('An MCGA, EGA or VGA is required for this feat.         ');
  58.   TextColor (Black);
  59.   TextBackground (Brown);
  60.   writeln;
  61.   writeln ('Else than that all systems are just fine (snafu, right :-).');
  62. end;  (* test3 *)
  63.  
  64. (* Main program
  65.    If you don't want a particular test, comment it away.
  66.    Q: Why don't software firms test their programs properly themselves
  67.       but leave it to the gullible user?
  68.    A: Because it is such a testing task (do I detect audible groans :-)
  69. *)
  70. begin
  71.   TEST1;
  72.   TEST2;
  73.   write ('Press <-'' '); readln;
  74.   TEST3;
  75.   write ('Press <-'' '); readln;
  76. end.  (* tsuntc.tst *)
  77.